home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / COMPILER / VP10B003 / VPC.ZIP / EXAMPLES / TOUCH / TOUCH.PAS < prev   
Pascal/Delphi Source File  |  1995-06-22  |  3KB  |  96 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Examples  Version 1.0             █}
  4. {█      TOUCH command line utility.                      █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1995 B&M&T Corporation             █}
  7. {█      ─────────────────────────────────────────────────█}
  8. {█      Written by Vitaly Miryanov                       █}
  9. {█                                                       █}
  10. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  11. {$I-,D-}
  12.  
  13. { Changes the date and time of selected files to the date }
  14. { and time at which the program is run.                   }
  15.  
  16. program Touch;
  17.  
  18. uses Dos, Use32;
  19.  
  20. {$IFDEF DYNAMIC_VERSION}
  21.   {$Dynamic System, Dos, Strings}
  22.   {$L VPRTL.LIB}
  23. {$ENDIF}
  24.  
  25. var
  26.   Time: Longint;
  27.   I: Integer;
  28.  
  29. { Reports an error, halts program execution }
  30.  
  31. procedure Error(const ErrStr: String);
  32. begin
  33.   WriteLn('**Error**  ', ErrStr);
  34.   Halt(2);
  35. end;
  36.  
  37. { Returns current date & time in the packed file format }
  38.  
  39. function GetDateTime: Longint;
  40. var
  41.   DT: DateTime;
  42.   DayOfWeek,Sec100: Word;
  43.   Time: Longint;
  44. begin
  45.   GetDate(DT.Year, DT.Month, DT.Day, DayOfWeek);
  46.   GetTime(DT.Hour, DT.Min  , DT.Sec, Sec100);
  47.   PackTime(DT, Time);
  48.   GetDateTime := Time;
  49. end;
  50.  
  51. { Touches file(s) specified by a given file name (wildcard) }
  52.  
  53. procedure DoTouch(const Wild: String);
  54. var
  55.   SR: SearchRec;
  56.   F: File;
  57.   FName: PathStr;
  58.   Dir: DirStr;
  59.   Name: NameStr;
  60.   Ext: ExtStr;
  61. begin
  62.   FSplit(Wild, Dir, Name, Ext);
  63.   FindFirst(Wild, 0, SR);
  64.   if DosError <> 0 then Error('Cannot locate file ' + Wild)
  65.  else
  66.   while DosError = 0 do
  67.   begin
  68.     FName := Dir + SR.Name;
  69.     Assign(F, FName);
  70.     { OS/2: Write only, deny read-write, fail on error }
  71.     { DOS: Write only }
  72.     FileMode := {$IFDEF OS2} $2011 {$ELSE} 1 {$ENDIF};
  73.     Reset(F);
  74.     if IOResult <> 0 then Error('Unable to open file ' + FName);
  75.     SetFTime(F, Time);
  76.     if DosError <> 0 then Error('Unable to change file date and time: ' + FName);
  77.     Close(F); InOutRes := 0;
  78.     FindNext(SR);
  79.   end;
  80. {$IFDEF OS2}
  81.   FindClose(SR);
  82. {$ENDIF}
  83. end;
  84.  
  85. begin
  86.   WriteLn('Virtual Pascal Touch  Version 1.0 Copyright (C) 1995 B&M&T Corporation');
  87.   if ParamCount = 0 then
  88.   begin
  89.     WriteLn('Syntax: TOUCH Arg1 [Arg2..Argn]');
  90.     WriteLn('where ArgX are file names or wildcards.');
  91.     Halt(1);
  92.   end;
  93.   Time := GetDateTime;
  94.   for I := 1 to ParamCount do DoTouch(ParamStr(I));
  95. end.
  96.